Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/icon_utl/iconmorf/iconmorf.bas

BASIC Source File | 1995-11-20 | 32KB | 1,099 lines

Option Explicit

 ' Constants:
  Global Const BLACKNESS = &H42&                       ' copy blackness
  Global Const SRCCOPY = &HCC0020                      ' copy source

  Global Const glICON_CELL = 34&                       ' size of icon cell
  Global Const gnTYPE_BAD = 0                          ' file is not icon or bitmap
  Global Const gnTYPE_ICON = 1                         ' file is an icon
  Global Const gnTYPE_BITMAP = 2                       ' file is a bitmap
  Global Const gsDELETED = "[Deleted]"                 ' deleted entry

 ' Types:

  ' icon reference
  Type IconType
    nIndex                             As Integer      ' index number
  End Type

 ' Variables:
  Global gbLoading                     As Integer      ' doing loading process
  Global gbWarning                     As Integer      ' show override warning
  Global gnBMP                         As Integer      ' bitmap to save
  Global gnBMPx(0 To 5)                As Integer      ' bitmap width
  Global gnBMPy(0 To 5)                As Integer      ' bitmap height
  Global gnFilter                      As Integer      ' list filter option
  Global gnFirstIcon                   As Integer      ' first icon displayed in viewer
  Global gnHeightViewerMin             As Integer      ' minimum viewer height
  Global gnHeightViewerNew             As Integer      ' minimum viewer width
  Global gnIconCols                    As Integer      ' number of columns of icons
  Global gnIconRows                    As Integer      ' number of rows of icons
  Global gnIconsMax                    As Integer      ' maximum number of icons to display
  Global gnLastIcon                    As Integer      ' last icon displayed in viewer
  Global gnWidthViewerMin              As Integer      ' minimum viewer width
  Global gnWidthViewerNew              As Integer      ' new viewer width\
  Global gtIcon(0 To 1199)             As IconType     ' icon information

Sub zzBordersToggle ()

  ' show and hide borders
  frmMorph!mnuOpBorders.Checked = Not frmMorph!mnuOpBorders.Checked
  frmMorph!shpSelectedIcon.Visible = frmMorph!mnuOpBorders.Checked
  frmMorph!shpMorph(0).Visible = frmMorph!mnuOpBorders.Checked
  frmMorph!shpMorph(1).Visible = frmMorph!mnuOpBorders.Checked
  frmMorph!shpMorph(2).Visible = frmMorph!mnuOpBorders.Checked
  frmMorph!shpMorph(3).Visible = frmMorph!mnuOpBorders.Checked
  frmMorph!shpMorph(4).Visible = frmMorph!mnuOpBorders.Checked
  frmMorph!shpMorph(5).Visible = frmMorph!mnuOpBorders.Checked

End Sub

Sub zzClearIcon ()

  ' clear icon
  frmMorph!picSelectedIcon.Picture = LoadPicture()
  frmMorph!picMorph(0).Picture = LoadPicture()
  frmMorph!picMorph(1).Picture = LoadPicture()
  frmMorph!picMorph(2).Picture = LoadPicture()
  frmMorph!picMorph(3).Picture = LoadPicture()
  frmMorph!picMorph(4).Picture = LoadPicture()
  frmMorph!picMorph(5).Picture = LoadPicture()

End Sub

Sub zzCopyIcon ()

 ' Description:
 '  delete selected icon

 ' Variables:
  Dim s1             As String
  Dim sFile          As String

  ' handle errors
  On Error Resume Next

  ' if entry selected
  If frmMorph!lstFiles.ListIndex >= 0 Then

    ' if not deleted
    If frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex) <> gsDELETED Then

      ' setup file path and name
      sFile = zzPathFormat(frmMorph!filList.Path) & frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex)

      ' if the file exists
      If zzFileExists(sFile) Then

        ' load form
        Load frmDirectory

        ' setup caption
        frmDirectory.Caption = "Copy " & UCase$(frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex)) & " to..."

        ' reset directory
        If frmMorph.Tag <> gsEMPTY Then
          frmDirectory!dirList.Path = frmMorph.Tag
          frmMorph.Tag = gsEMPTY
        End If

        ' give user option to choose directory
        frmDirectory.Show MODAL

        ' if directory selected
        If frmMorph.Tag <> gsEMPTY Then

          ' reset error flag
          Err = 0

          ' copy file
          s1 = zzPathFormat(frmMorph.Tag) & frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex)
          FileCopy sFile, s1

          ' tell user of error
          If Err <> 0 Then
            s1 = UCase$(frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex)) & " could not be copyed to "
            s1 = s1 & UCase$(frmMorph.Tag) & " because of a """ & Error$ & """ error."
            MsgBox s1, MB_ICONSTOP
          End If

        End If

      ' tell user cannot find
      Else
        MsgBox UCase$(sFile) & " icon not found.", MB_ICONSTOP
      End If

    ' tell user already deleted
    Else
      MsgBox "Icon has been deleted.", MB_ICONSTOP
    End If

  End If

End Sub

Sub zzDeleteIcon ()

 ' Description:
 '  delete selected icon

 ' Variables:
  Dim nX             As Integer
  Dim nR             As Integer
  Dim s1             As String
  Dim sFile          As String

  ' handle errors
  On Error Resume Next

  ' if entry selected
  If frmMorph!lstFiles.ListIndex >= 0 Then

    ' setup index reference
    nX = frmMorph!lstFiles.ListIndex

    ' setup file path and name
    sFile = zzPathFormat(frmMorph!filList.Path) & frmMorph!lstFiles.List(nX)

    ' if the file exists
    If zzFileExists(sFile) Then

      ' is user warning flag on
      If frmMorph!mnuOpDeleteWarn.Checked Then

        ' give user chance to abort
        s1 = "Delete " & UCase$(sFile) & " file?"
        If MsgBox(s1, MB_ICONQUESTION Or MB_YESNO) <> IDYES Then Exit Sub

      End If

      ' delete selected entry
      Kill sFile

      ' tell user of error
      If Err <> 0 Then
        MsgBox Error$

      ' no error so
      Else

        ' replace name with deleted flag
        frmMorph!lstFiles.List(nX) = gsDELETED

        ' fade to black
        If nX < 400 Then
          nR = BitBlt(frmMorph!picStorage(0).hDC, 2 + nX * glICON_CELL, 0, 32, 32, 0, 0, 0, BLACKNESS)
        ElseIf nX < 800 Then
          nR = BitBlt(frmMorph!picStorage(1).hDC, 2 + (nX - 400) * glICON_CELL, 0, 32, 32, 0, 0, 0, BLACKNESS)
        ElseIf nX < 1200 Then
          nR = BitBlt(frmMorph!picStorage(2).hDC, 2 + (nX - 800) * glICON_CELL, 0, 32, 32, 0, 0, 0, BLACKNESS)
        End If

        ' redisplay to shown "blackened" one
        Call zzDisplayIcons

        ' if not at end of list
        If nX < frmMorph!lstFiles.ListCount - 1 Then

          ' move toward end until entry that is not deleted is found
          Do
            If frmMorph!lstFiles.ListIndex < frmMorph!lstFiles.ListCount - 1 Then
              frmMorph!lstFiles.ListIndex = frmMorph!lstFiles.ListIndex + 1
            Else
              If frmMorph!lstFiles.ListCount > 0 Then
                frmMorph!lstFiles.ListIndex = 0
              Else
                frmMorph!lstFiles.ListIndex = -1
              End If
              Exit Do
            End If
          Loop Until frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex) <> gsDELETED

        ' if at end of list then
        ' go back to top
        Else
          If frmMorph!lstFiles.ListCount > 0 Then
            frmMorph!lstFiles.ListIndex = 0
          Else
            frmMorph!lstFiles.ListIndex = -1
          End If
        End If

      End If

    ' tell user already deleted
    Else
      MsgBox "File already deleted.", MB_ICONSTOP
    End If

  End If

End Sub

Sub zzDeleteIcons ()

 ' Description:
 '  Delete All icons

 ' Variables:
  Dim bDelFlag  As Integer     ' save warning flag
  Dim nX        As Integer     ' loop counter

  ' change to path
  ChDrive frmMorph!drvList.Drive
  ChDir frmMorph!filList.Path

  ' ask user if they are sure
  If MsgBox("Are you sure you wish to delete all listed files?", MB_ICONQUESTION Or MB_YESNO Or MB_DEFBUTTON2) = IDYES Then

    ' ask user if they are sure
    If MsgBox("Once again, are you absolutely sure you wish to delete all listed files?", MB_ICONQUESTION Or MB_YESNO Or MB_DEFBUTTON2) = IDYES Then

      ' setup warning option
      bDelFlag = frmMorph!mnuOpDeleteWarn.Checked
      If frmMorph!mnuOpDeleteWarn.Checked Then
        frmMorph!mnuOpDeleteWarn.Checked = MsgBox("Do you wish to display a warning message before deleting each file?", MB_ICONQUESTION Or MB_YESNO Or MB_DEFBUTTON2) = IDYES
      End If

      ' please wait...
      Screen.MousePointer = HOURGLASS

      ' make sure above all other forms
      zzFormFloat frmMorph

      ' if each icon in list
      For nX = 0 To frmMorph!lstFiles.ListCount - 1

        ' if valid icon then
        If zzFileType(frmMorph!lstFiles.List(nX), True) <> gnTYPE_BAD Then

          ' set list index
          frmMorph!lstFiles.ListIndex = nX

          ' delete icon
          Call zzDeleteIcon

        End If

      Next nX

      ' sink back
      If Not frmMorph!mnuOpFloat.Checked Then
        zzFormUnfloat frmMorph
      End If

      ' ...done
      Screen.MousePointer = DEFAULT

      ' set to first icon
      If frmMorph!lstFiles.ListCount > 0 Then
        frmMorph!lstFiles.ListIndex = -1
        frmMorph!lstFiles.ListIndex = 0
      End If

      ' reset warning flag
      frmMorph!mnuOpDeleteWarn.Checked = bDelFlag

      ' refresh all icons
      Call zzRefreshIcons

    End If

  End If

End Sub

Sub zzDisplayIcons ()

 ' Description:
 '  Display icons

 ' Variables:
  Dim nCurCol             As Integer
  Dim nCurRow             As Integer
  Dim nPixelWidth         As Integer
  Dim nIcon               As Integer
  Dim nR                  As Integer

  ' clear viewing area
  frmViewer!picIcons.Cls

  ' Determine what icon should be the first icon displayed (Upper left hand
  ' corner of viewing window) based on the current value of the Scrollbar.
  gnFirstIcon = frmViewer!vsbIcons.Value * gnIconCols

  ' calculate last icon
  gnLastIcon = gnFirstIcon + (gnIconRows * gnIconCols) + gnIconCols
  If gnLastIcon > frmMorph!lstFiles.ListCount - 1 Then
    gnLastIcon = frmMorph!lstFiles.ListCount - 1
  End If

  ' for each icon in the loop
  For nIcon = gnFirstIcon To gnLastIcon

      ' calculate current column and row
      nCurRow = (nIcon - gnFirstIcon) \ gnIconCols
      nCurCol = (nIcon - gnFirstIcon) Mod gnIconCols

      ' copy from first storage area
      If nIcon < 400 Then
        nR = BitBlt(frmViewer!picIcons.hDC, nCurCol * glICON_CELL, nCurRow * glICON_CELL, glICON_CELL, glICON_CELL, frmMorph!picStorage(0).hDC, 2 + nIcon * glICON_CELL, 0, SRCCOPY)

      ' copy from second storage area
      ElseIf nIcon < 800 Then
        nR = BitBlt(frmViewer!picIcons.hDC, nCurCol * glICON_CELL, nCurRow * glICON_CELL, glICON_CELL, glICON_CELL, frmMorph!picStorage(1).hDC, 2 + (nIcon - 400) * glICON_CELL, 0, SRCCOPY)

      ' copy from third storage area
      ElseIf nIcon < 1200 Then
        nR = BitBlt(frmViewer!picIcons.hDC, nCurCol * glICON_CELL, nCurRow * glICON_CELL, glICON_CELL, glICON_CELL, frmMorph!picStorage(2).hDC, 2 + (nIcon - 800) * glICON_CELL, 0, SRCCOPY)
      End If

  Next nIcon

End Sub

Function zzFileType (ByVal sFileName$, ByVal bPrompt%) As Integer

 ' Description:
 '  Is file a valid icon or bitmap

 ' Parameters:
 '  sFileName           file name (including path)
 '  bPrompt             display prompt if bad

 ' Variables:
  Dim s1 As String

  ' handle errors
  On Error Resume Next
  Err = False

  ' if file has been deleted
  If sFileName <> gsDELETED Then

    ' set drag icon which will error if not valid icon

    ' if loading only icons then setting the drag icon
    ' to the image will determine if it is an icon or not
    If gnFilter = 0 Then

      ' see if icon
      frmMorph!picSelectedIcon.DragIcon = LoadPicture(sFileName)
      If Err = False Then
        zzFileType = gnTYPE_ICON
      Else
        zzFileType = gnTYPE_BAD
        If bPrompt Then MsgBox UCase$(sFileName) & " is not an icon file.", MB_ICONSTOP
      End If

    ' bitmaps
    ElseIf gnFilter = 1 Then

      ' see if bitmap
      frmMorph!picBitmap.Picture = LoadPicture(sFileName)
      If Err = False Then

        ' must be smaller than 32x32
        If frmMorph!picBitmap.Width > 32 Then
          zzFileType = gnTYPE_BAD
          If bPrompt Then
            s1 = UCase$(sFileName) & " is "
            s1 = s1 & Format$(frmMorph!picBitmap.Width) & " x "
            s1 = s1 & Format$(frmMorph!picBitmap.Height) & " pixels"
            s1 = s1 & " which is too large to process."
            MsgBox s1, MB_ICONSTOP
          End If
        ElseIf frmMorph!picBitmap.Width > 32 Then
          zzFileType = gnTYPE_BAD
          If bPrompt Then
            s1 = UCase$(sFileName) & " is "
            s1 = s1 & Format$(frmMorph!picBitmap.Width) & " x "
            s1 = s1 & Format$(frmMorph!picBitmap.Height) & " pixels"
            s1 = s1 & " which is too large to process."
            MsgBox s1, MB_ICONSTOP
          End If
        Else
          zzFileType = gnTYPE_BITMAP
        End If

      ' not bitmap at all
      Else
        zzFileType = gnTYPE_BAD
        If bPrompt Then MsgBox UCase$(sFileName) & " is not a bitmap file.", MB_ICONSTOP
      End If

    ' all files
    ElseIf gnFilter = 2 Or gnFilter = 3 Then

      ' see if icon
      frmMorph!picSelectedIcon.DragIcon = LoadPicture(sFileName)
      If Err = False Then
        zzFileType = gnTYPE_ICON

      ' see if bitmap
      Else

        ' see if bitmap
        Err = False
        frmMorph!picBitmap.Picture = LoadPicture(sFileName)
        If Err = False Then

          ' must be smaller than 32x32
          If frmMorph!picBitmap.Width > 32 Then
            zzFileType = gnTYPE_BAD
            If bPrompt Then
              s1 = UCase$(sFileName) & " is "
              s1 = s1 & Format$(frmMorph!picBitmap.Width) & " x "
              s1 = s1 & Format$(frmMorph!picBitmap.Height) & " pixels"
              s1 = s1 & " which is too large to process."
              MsgBox s1, MB_ICONSTOP
            End If
          ElseIf frmMorph!picBitmap.Width > 32 Then
            zzFileType = gnTYPE_BAD
            If bPrompt Then
              s1 = UCase$(sFileName) & " is "
              s1 = s1 & Format$(frmMorph!picBitmap.Width) & " x "
              s1 = s1 & Format$(frmMorph!picBitmap.Height) & " pixels"
              s1 = s1 & " which is too large to process."
              MsgBox s1, MB_ICONSTOP
            End If
          Else
            zzFileType = gnTYPE_BITMAP
          End If

        ' not bitmap at all
        Else
          zzFileType = gnTYPE_BAD
          If bPrompt Then MsgBox UCase$(sFileName) & " is not an icon or bitmap file.", MB_ICONSTOP
        End If

      End If

    End If

  ' file has been deleted
  Else
    zzFileType = gnTYPE_BAD
  End If

End Function

Sub zzGreyToggle ()

  ' toggle switch
  frmMorph!mnuOpGrey.Checked = Not frmMorph!mnuOpGrey.Checked

  ' use grey background
  If frmMorph!mnuOpGrey.Checked Then
    frmMorph!picSelectedIcon.BackColor = BUTTON_GRAY
    frmMorph!picMorph(0).BackColor = BUTTON_GRAY
    frmMorph!picMorph(1).BackColor = BUTTON_GRAY
    frmMorph!picMorph(2).BackColor = BUTTON_GRAY
    frmMorph!picMorph(3).BackColor = BUTTON_GRAY
    frmMorph!picMorph(4).BackColor = BUTTON_GRAY
    frmMorph!picMorph(5).BackColor = BUTTON_GRAY
    frmMorph!picStorage(0).BackColor = BUTTON_GRAY
    frmMorph!picStorage(1).BackColor = BUTTON_GRAY
    frmMorph!picStorage(2).BackColor = BUTTON_GRAY
    frmViewer!picIcons.BackColor = BUTTON_GRAY

  ' use white
  Else
    frmMorph!picSelectedIcon.BackColor = WHITE
    frmMorph!picMorph(0).BackColor = WHITE
    frmMorph!picMorph(1).BackColor = WHITE
    frmMorph!picMorph(2).BackColor = WHITE
    frmMorph!picMorph(3).BackColor = WHITE
    frmMorph!picMorph(4).BackColor = WHITE
    frmMorph!picMorph(5).BackColor = WHITE
    frmMorph!picStorage(0).BackColor = WHITE
    frmMorph!picStorage(1).BackColor = WHITE
    frmMorph!picStorage(2).BackColor = WHITE
    frmViewer!picIcons.BackColor = WHITE
  End If

  ' refresh all icons
  Call zzRefreshIcons

End Sub

Sub zzLoadIcon (ByVal sIcon$)

  ' load icon from file
  frmMorph!picSelectedIcon.Picture = LoadPicture(sIcon)

  ' change caption
  frmViewer.Caption = "[" & sIcon & "] Icon Viewer"

  ' refresh picture
  frmMorph!picSelectedIcon.Refresh

  ' morph to bitmaps
  Call zzMorphIcon(sIcon)

End Sub

Sub zzLoadIcons ()

 ' Description:
 '  Show all icons

 ' Variables:
  Dim nListCount As Integer
  Dim nR         As Integer
  Dim nX         As Integer
  Dim sListCount As String

  ' make sure directory is current
  If CurDir$ <> frmMorph!filList.Path Then
    ChDir frmMorph!filList.Path
  End If

  ' please wait...
  Screen.MousePointer = HOURGLASS

  ' refresh to pick up new files
  frmMorph!filList.Refresh

  ' is scroll bar needed
  frmViewer!vsbIcons.Visible = frmMorph!filList.ListCount > gnIconsMax

  ' reset to top
  frmViewer!vsbIcons.Value = 0

  ' display viewing window
  frmViewer!picIcons.Visible = True

  ' get count of icons
  nListCount = frmMorph!filList.ListCount

  ' setup "storage" bitmaps
  If nListCount < 401 Then
    frmMorph!picStorage(0).Width = nListCount * glICON_CELL
    frmMorph!picStorage(1).Width = 1
    frmMorph!picStorage(2).Width = 1
  ElseIf frmMorph!filList.ListCount < 801 Then
    frmMorph!picStorage(0).Width = 400 * glICON_CELL
    frmMorph!picStorage(1).Width = (nListCount - 400) * glICON_CELL
    frmMorph!picStorage(2).Width = 1
  ElseIf frmMorph!filList.ListCount < 1201 Then
    frmMorph!picStorage(0).Width = 400 * glICON_CELL
    frmMorph!picStorage(1).Width = 400 * glICON_CELL
    frmMorph!picStorage(2).Width = (nListCount - 800) * glICON_CELL
  End If

  frmMorph!picStorage(0).Cls
  frmMorph!picStorage(1).Cls
  frmMorph!picStorage(2).Cls

  ' setup picture to act as "transporter" to bitmap
  frmMorph!picSelectedIcon.Visible = False
  frmMorph!picSelectedIcon.AutoRedraw = True

  ' setup and show counter
  sListCount = " of " & Format$(nListCount) & " loaded"

  ' hide and show controls
  frmMorph!lstFiles.Visible = False
  frmMorph!picPrint.Visible = True
  frmMorph!lstFiles.Refresh
  frmMorph!picPrint.Refresh

  ' clear list box
  frmMorph!lstFiles.Clear

  ' reset label
  frmMorph!fraIcons.Caption = Format$(nListCount) + " &Icons"
  frmMorph!fraIcons.Refresh

  ' if each icon in list
  For nX = 0 To nListCount - 1

    ' print counter
    frmMorph!picPrint.Cls
    frmMorph!picPrint.Print Format$(nX + 1) & sListCount

    ' add file to list box
    frmMorph!lstFiles.AddItem frmMorph!filList.List(nX)

    ' setup array reference
    gtIcon(nX).nIndex = nX

    ' if not valid icon then display black square
    If zzFileType(frmMorph!filList.List(nX), False) = gnTYPE_BAD Then

      ' copy into first storage area
      If nX < 400 Then
        nR = BitBlt(frmMorph!picStorage(0).hDC, 2 + nX * glICON_CELL, 0, 32, 32, 0, 0, 0, BLACKNESS)

      ' copy into second storage area
      ElseIf nX < 800 Then
        nR = BitBlt(frmMorph!picStorage(1).hDC, 2 + (nX - 400) * glICON_CELL, 0, 32, 32, 0, 0, 0, BLACKNESS)

      ' copy into third storage area
      ElseIf nX < 1200 Then
        nR = BitBlt(frmMorph!picStorage(2).hDC, 2 + (nX - 800) * glICON_CELL, 0, 32, 32, 0, 0, 0, BLACKNESS)
      End If

    ' valid so display
    Else

      ' load icon from file
      frmMorph!picSelectedIcon.Picture = LoadPicture(frmMorph!filList.List(nX))
      frmMorph!picSelectedIcon.Refresh

      ' copy into first storage area
      If nX < 400 Then
        nR = BitBlt(frmMorph!picStorage(0).hDC, 2 + nX * glICON_CELL, 0, 32, 32, frmMorph!picSelectedIcon.hDC, 0, 0, SRCCOPY)

      ' copy into second storage area
      ElseIf nX < 800 Then
        nR = BitBlt(frmMorph!picStorage(1).hDC, 2 + (nX - 400) * glICON_CELL, 0, 32, 32, frmMorph!picSelectedIcon.hDC, 0, 0, SRCCOPY)

      ' copy into third storage area
      ElseIf nX < 1200 Then
        nR = BitBlt(frmMorph!picStorage(2).hDC, 2 + (nX - 800) * glICON_CELL, 0, 32, 32, frmMorph!picSelectedIcon.hDC, 0, 0, SRCCOPY)
      End If

    End If

  Next nX

  ' hide and show controls
  frmMorph!lstFiles.Visible = True
  frmMorph!picPrint.Visible = False

  ' ...done
  Screen.MousePointer = DEFAULT

  ' redisplay selected icon picture
  frmMorph!picSelectedIcon.Visible = True
  frmMorph!picSelectedIcon.AutoRedraw = False

  ' set to first icon
  If frmMorph!lstFiles.ListCount > 0 Then
    frmMorph!lstFiles.ListIndex = 0
  End If

  ' reset menu options
  Call zzResetMenuOptions

End Sub

Sub zzMorphIcon (ByVal sIcon$)

 ' Description:
 '  Morph single icon

 ' Parmeters:
 '  sIcon                      icon to morph

 ' Variables:
  Dim nR        As Integer     ' return code
  Dim nX        As Integer     ' loop counter

  ' load picture
  frmMorph!picSelectedIcon.Picture = LoadPicture(sIcon)
  frmMorph!picSelectedIcon.Refresh

  ' morph 'em
  For nX = 0 To 5

    ' use StrecthBlt
    nR = StretchBlt(frmMorph!picMorph(nX).hDC, 0, 0, gnBMPx(nX), gnBMPy(nX), frmMorph!picSelectedIcon.hDC, 0, 0, 32, 32, SRCCOPY)

    ' refresh picture so it can be saved
    frmMorph!picMorph(nX).Picture = frmMorph!picMorph(nX).Image
    frmMorph!picMorph(nX).Refresh

  Next nX

End Sub

Sub zzMorphOne ()

 ' Variables:
  Dim bCancel As Integer

  ' if one selected
  If frmMorph!lstFiles.ListIndex >= 0 Then

    ' setup path
    ChDrive frmMorph!drvList.Drive
    ChDir frmMorph!filList.Path

    ' morph and save it
    Call zzSaveIcon(frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex), bCancel)

  End If

End Sub

Sub zzOptionsFloat ()

  ' toggle switch
  frmMorph!mnuOpFloat.Checked = Not frmMorph!mnuOpFloat.Checked

  ' float or sink
  If frmMorph!mnuOpFloat.Checked Then
    zzFormFloat frmMorph
  Else
    zzFormUnfloat frmMorph
  End If

End Sub

Sub zzRefreshIcons ()

 ' Description:
 '  Refresh icons

  ' can display up to 1200
  If frmMorph!filList.ListCount > 1200 Then
    MsgBox "Can only display up to a maximum of 1200 icons.", MB_ICONSTOP

  ' if ok number to show
  Else

    ' load all the icons
    zzLoadIcons

    ' display all the icons
    zzDisplayIcons

    ' reset display
    Call zzResizeViewer

  End If

End Sub

Sub zzRenameIcon ()

 ' Description:
 '  Rename selected icon

 ' Variables:
  Dim s1             As String
  Dim sFileNew       As String
  Dim sFileOld       As String
  Dim sPath          As String

  ' handle errors
  On Error Resume Next

  ' if entry selected
  If frmMorph!lstFiles.ListIndex >= 0 Then

    ' setup file path and name
    sPath = zzPathFormat(frmMorph!filList.Path)
    sFileOld = frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex)

    ' if file not deleted
    If sFileOld <> gsDELETED Then

      ' if the file exists
      If zzFileExists(sPath & sFileOld) Then

        ' ask user to change
        s1 = "Enter the new name for the " & UCase$(sFileOld) & " icon below:"
        sFileNew = InputBox(s1, App.Title, sFileOld)

        ' if name entered and not same as last time
        If sFileNew <> gsEMPTY And UCase$(sFileNew) <> UCase$(sFileOld) Then

          ' rename selected entry
          Name sPath & sFileOld As sPath & sFileNew

          ' tell user of error
          If Err <> 0 Then
            s1 = UCase$(sFileOld) & " could not be renamed to "
            s1 = s1 & UCase$(sFileNew) & " because of a """ & Error$ & """ error."
            MsgBox s1, MB_ICONSTOP

          ' no error then rename in list
          Else
            frmMorph!lstFiles.List(frmMorph!lstFiles.ListIndex) = LCase$(sFileNew)
          End If

        End If

      ' tell user not found
      Else
        MsgBox UCase$(sPath & sFileOld) & " not found.", MB_ICONSTOP
      End If
    ' file deleted

    Else
      MsgBox "Icon has been deleted.", MB_ICONSTOP
    End If

  End If

End Sub

Sub zzResetMenuOptions ()

  ' enable/disable menu options
  frmMorph!mnuOpMorphOne.Enabled = frmMorph!lstFiles.ListIndex > -1
  frmMorph!mnuOpCopy.Enabled = frmMorph!lstFiles.ListIndex > -1
  frmMorph!mnuOpDelete.Enabled = frmMorph!lstFiles.ListIndex > -1
  frmMorph!mnuOpRename.Enabled = frmMorph!lstFiles.ListIndex > -1
  frmMorph!mnuOpShowAll.Enabled = frmMorph!lstFiles.ListCount > 0
  frmMorph!mnuOpMorphAll.Enabled = frmMorph!lstFiles.ListCount > 0

End Sub

Sub zzResizeViewer ()

 ' Description:
 '  Resize and reposition controls

 ' Variables:
  Dim nDiff As Integer    ' difference between maximum number of
                          ' icons that can be shown and number to show

  ' do nothing if minimized
  If frmViewer.WindowState <> MINIMIZED Then

    ' if form to small
    If (frmViewer.Width < gnWidthViewerMin) Or (frmViewer.Height < gnHeightViewerMin) Then

      ' determine new width
      If frmViewer.Width < gnWidthViewerMin Then gnWidthViewerNew = gnWidthViewerMin Else gnWidthViewerNew = frmViewer.Width

      ' determine new height
      If frmViewer.Height < gnHeightViewerMin Then gnHeightViewerNew = gnHeightViewerMin Else gnHeightViewerNew = frmViewer.Height

      ' reset form
      frmViewer.Move frmViewer.Left, frmViewer.Top, gnWidthViewerNew, gnHeightViewerNew

    ' form big enough so
    Else

      ' save new settings
      gnHeightViewerNew = frmViewer.Height
      gnWidthViewerNew = frmViewer.Width

      ' recalculate columns, rows, and maximum
      ' assuming no scroll bar
      gnIconCols = frmViewer.ScaleWidth \ glICON_CELL
      gnIconRows = frmViewer.ScaleHeight \ glICON_CELL
      gnIconsMax = gnIconCols * gnIconRows

      ' reset scroll values
      frmViewer!vsbIcons.Value = 0
      frmViewer!vsbIcons.Max = 0

      ' if all icons cannot be displayed
      If frmMorph!lstFiles.ListCount > gnIconsMax Then

        ' show scroll bar
        frmViewer!vsbIcons.Visible = True

        ' position scroll bar
        frmViewer!vsbIcons.Left = frmViewer.ScaleWidth - frmViewer!vsbIcons.Width
        frmViewer!vsbIcons.Top = 0
        frmViewer!vsbIcons.Height = frmViewer.ScaleHeight

        ' position viewer area
        frmViewer!picIcons.Width = frmViewer!vsbIcons.Left - 1
        frmViewer!picIcons.Height = frmViewer.ScaleHeight

        ' recalc columns and maximum
        gnIconCols = frmViewer!vsbIcons.Left \ glICON_CELL
        gnIconsMax = gnIconCols * gnIconRows

        ' calc difference
        nDiff = frmMorph!lstFiles.ListCount - gnIconsMax

        ' set maximum scroll value
        frmViewer!vsbIcons.Max = nDiff \ gnIconCols
        If (nDiff Mod gnIconCols) Then frmViewer!vsbIcons.Max = frmViewer!vsbIcons.Max + 1

        ' set big scroll value
        frmViewer!vsbIcons.LargeChange = gnIconRows

      ' all icons can be shown
      Else

        ' hide scroll bar
        frmViewer!vsbIcons.Visible = False

        ' position viewer area
        frmViewer!picIcons.Width = frmViewer.ScaleWidth
        frmViewer!picIcons.Height = frmViewer.ScaleHeight

      End If

      ' update viewing area
      If frmMorph!lstFiles.ListCount > 0 Then
        If Not gbLoading Then zzDisplayIcons
      End If

      ' float main form so it doesn't disappear
      If frmViewer.WindowState = MAXIMIZED Then
        If Not frmMorph!mnuOpFloat.Checked Then
          Call zzOptionsFloat
        End If
      End If

    End If

  End If

End Sub

Sub zzSaveIcon (ByVal sIcon$, bCancel%)

 ' Description:
 '  Save single icon

 ' Parmeters:
 '  sIcon                      icon to morph
 '  bSave                      save file to disk
 '  bCancel                    cancel flag

 ' Variables:
  Dim bWrite        As Integer     ' write flag
  Dim nR            As Integer     ' return code
  Dim sFileName     As String      ' file name

  ' if icon has been deleted
  If sIcon$ <> gsDELETED Then

    ' if this is an icon
    If zzFileType(sIcon, False) = gnTYPE_ICON Then

      ' format file name
      sFileName = Left$(sIcon, Len(sIcon) - 3) + "bmp"

      ' save to application directory
      If frmMorph!mnuOpSaveAppDir.Checked Then
        sFileName = App.Path & "\" & sFileName
      End If

      ' if warning and saving to file
      If gbWarning Then

        ' if file exists handle options
        If zzFileExists(sFileName) Then

          ' ask user
          nR = MsgBox(UCase$(sFileName) & " already exists. Do you wish to overwrite the file?", MB_ICONQUESTION Or MB_YESNOCANCEL)

          ' cancel
          If nR = IDCANCEL Then bCancel = True: Exit Sub

          ' write anyway?
          bWrite = (nR = IDYES)

        ' write if it doesn't exist
        Else
          bWrite = True
        End If

      ' write without warning
      Else
        bWrite = True
      End If

      ' if writing
      If bWrite Then

        ' load picture
        frmMorph!picSelectedIcon.Picture = LoadPicture(sIcon)
        frmMorph!picSelectedIcon.Refresh

        ' stretch it
        nR = StretchBlt(frmMorph!picMorph(gnBMP).hDC, 0, 0, gnBMPx(gnBMP), gnBMPy(gnBMP), frmMorph!picSelectedIcon.hDC, 0, 0, 32, 32, SRCCOPY)

        ' refresh picture o it can be saved
        frmMorph!picMorph(gnBMP).Picture = frmMorph!picMorph(gnBMP).Image
        frmMorph!picMorph(gnBMP).Refresh

        ' save bitmap
        SavePicture frmMorph!picMorph(gnBMP).Picture, sFileName

      End If

    ' not an icon
    Else
       MsgBox "Selected file must be an icon.", MB_ICONSTOP
    End If

  ' icon deleted
  Else
     MsgBox "Selected Icon has been deleted.", MB_ICONSTOP
  End If

End Sub

Sub zzSaveIcons ()

 ' Description:
 '  Save Icons

 ' Variables:
  Dim bCancel   As Integer     ' cancel
  Dim nX        As Integer     ' loop counter

  ' change to path
  ChDrive frmMorph!drvList.Drive
  ChDir frmMorph!filList.Path

  ' please wait...
  Screen.MousePointer = HOURGLASS

  ' make sure above all other forms
  zzFormFloat frmMorph

  ' if each icon in list
  For nX = 0 To frmMorph!lstFiles.ListCount - 1

    ' if valid icon then
    If zzFileType(frmMorph!lstFiles.List(nX), True) = gnTYPE_ICON Then

      ' save icon
      Call zzSaveIcon(frmMorph!lstFiles.List(nX), bCancel)

      ' user cancelled
      If bCancel Then Exit For

    End If

  Next nX

  ' sink back
  If Not frmMorph!mnuOpFloat.Checked Then
    zzFormUnfloat frmMorph
  End If

  ' ...done
  Screen.MousePointer = DEFAULT

  ' set to first icon
  If frmMorph!lstFiles.ListCount > 0 Then
    frmMorph!lstFiles.ListIndex = -1
    frmMorph!lstFiles.ListIndex = 0
  End If

End Sub

Sub zzViewerToggle ()

  ' toggle
  frmMorph!mnuOpViewer.Checked = Not frmMorph!mnuOpViewer.Checked

  ' show/hide viewer
  If frmMorph!mnuOpViewer.Checked Then
    frmViewer.Show
  Else
    frmViewer.Hide
  End If

End Sub